home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Quick Edit ƒ / QEconsole < prev    next >
Text File  |  1996-03-02  |  3KB  |  156 lines
  1. ¥ string+ QEstr  ¥ 12Nov95 DBH already defined in Mops release
  2.  
  3. : .S++     ¥ 29Jan94 DBH
  4.     ok
  5.     depth  0<= IF cr EXIT  THEN
  6.     sp@ depth 2- 4* +
  7.     depth 1- FOR  dup .cell  4-  NEXT drop cr
  8.     ;
  9.  
  10. : QEtype    ( addr len -- )
  11.     text: tQE ;
  12.  
  13. : QEemit  ( char -- )
  14.     emitvar c!
  15.     emitvar 1 QEtype ;
  16.  
  17. : QEcr
  18.     cr: tQE drop ;    ¥ should error check?
  19.  
  20. : QEsps
  21.     dup 0<= IF  drop  EXIT  THEN
  22.     pad swap 2dup bl fill QEtype ;
  23.  
  24.  
  25. : qeErrDump cr SRC-START SRC-LEN QEtype
  26.     cr >in @ 1- spaces & ^ emit ;
  27.  
  28. : OpenToError
  29.     topFile nilP <>
  30.     IF      ¥ We try to open the source in QE.  We don't use LOCATE_SRC
  31.             ¥  since here we only want a source display if it's QE.
  32.         topFile ?open_in_QE
  33.         pos: topFile  move_curs
  34.     THEN ;
  35.  
  36. resource QEerrorRes
  37.  
  38. : qeDIE
  39.     OpenToError
  40.     -echo   0 -> (err#)        ¥ Clear error indicator from AppleEvents
  41.     'type STR  swap set: QEerrorRes
  42.     getnew: QEerrorRes
  43.     lock: QEerrorRes
  44.     cr ptr: QEerrorRes count QEtype
  45.     unlock: QEerrorRes
  46.     qeErrDump
  47.     cr cl3
  48.     unlock: QEstr
  49.     become EventLoop ;
  50.  
  51. : QEquit
  52.     unlock: QEstr
  53.     become EventLoop ;
  54.  
  55. : >QECONS
  56.     true -> prompt?
  57.     ['] QEtype -> typevec
  58.     ['] QEemit    -> emitvec
  59.     ['] QEcr    -> crvec
  60.     ['] QEsps     -> spvec
  61.     ['] QEemit     -> echovec
  62.     ['] null     -> setfwind
  63.     ['] qeDIE     -> dflt-die
  64.     ['] QEquit    -> quitvec
  65.     ;
  66.  
  67.  
  68. ¥ ' >QECONS -> SuspendVec ¥ going to Quick Edit, probably
  69.  
  70. ' NEWVECS -> ResumeVec
  71.  
  72.  
  73. : skip_line
  74.     13 chsearch: QEstr
  75.     negate more: QEstr
  76.     delete: QEstr  nolim: QEstr ;
  77.  
  78. : skip1
  79.     1 skip: QEstr ;
  80.  
  81. : BL->CR/TB  { ¥ notparms -- }
  82.     true -> notparms
  83.     reset: QEstr
  84.     BEGIN
  85.         len: QEstr
  86.     WHILE
  87.         1st: QEstr
  88.         CASE[ & ¥ ]=>     notparms IF skip_line ELSE skip1 THEN
  89.             [ & { ]=>  false -> notparms skip1    ¥ do not allow skip_line after a '{' until '}'
  90.             [ & } ]=>  true  -> notparms skip1    ¥ ok to allow skip_line after a '}'
  91.             [ 13  ]=> skip1        ¥ DO NOT replace cr's     ¥ 23Jan94 DBH
  92.             [ 0 31 RANGE]=> 32 chovwr: QEstr
  93.             DEFAULT=> drop skip1
  94.         ]CASE
  95.     REPEAT
  96.     reset: QEstr ;
  97.  
  98. : DoEvaluate     ¥ 23Jan94 DBH
  99.     begin: QEstr
  100.     BEGIN
  101.         nextline?: QEstr
  102.     WHILE
  103.         get: QEstr evaluate
  104.     REPEAT ;
  105.  
  106.  
  107. : EvalFromQE
  108.     BL->CR/TB
  109.     lock: QEstr
  110. ¥    get: QEstr  evaluate
  111.     DoEvaluate     ¥ 23Jan94 DBH
  112.     unlock: QEstr
  113.     prompt? IF  .s++  THEN
  114.     ;
  115.  
  116. : DoHLevent     ¥ ( -- b )
  117.     msgClass: fEvent  'type TEXT  =  ¥ a simple check for proper class
  118.     IF
  119.         msgID: fEvent  put: QEhand  ¥ message ID is merely the handle from QE
  120.         ptr: QEhand  size: QEhand  put: QEstr
  121.         evalFromQE  ¥ update: TW cr     ¥ 01Feb94 DBH  Need the cr to insert: tw
  122.         prompt? not IF cr THEN
  123.         true            ¥ we did handle the event
  124.         wnd TW = IF newvecs update: TW THEN
  125.     ELSE
  126.         false            ¥ we did not handle the event
  127.     THEN
  128.     ;
  129.  
  130.  
  131. : InitQEconsole
  132.     instld?  ?EXIT            ¥ Mustn't do this in installed apps
  133.     true -> resume?
  134.     ['] DoHLevent -> HLeventVec
  135.     new: QEstr ;
  136.     
  137. InitQEconsole
  138.  
  139. ' InitQEconsole add: init_actions
  140.  
  141.  
  142. ¥ need to redefine NEWVECS to also reset dflt-die
  143. :f NEWVECS
  144.     false -> prompt?
  145.     ['] xemit    -> emitvec
  146.     ['] xcr        -> crvec
  147.     ['] xtyp    -> typevec
  148.     ['] xsps     -> spvec
  149.     ['] xemit     -> echovec
  150.     ['] setTW    -> setfWind 
  151.     ['] xquit    -> quitvec
  152.     ['] bye+    -> byevec
  153.     ¥ here's what's new
  154.     ['] err_src -> dflt-die
  155. ;f
  156.